home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
basic
/
6300gray.zip
/
GRAY.BAS
< prev
next >
Wrap
BASIC Source File
|
1988-08-12
|
6KB
|
144 lines
10 REM %%%%%%%%%%%%%%%%%%%
15 REM % Function Key 10 %
20 REM % returns to DOS %
25 REM %%%%%%%%%%%%%%%%%%%
30 KEY OFF : KEY 10,""
35 KEY (10) ON : ON KEY(10) GOSUB 675
40 SCREEN 100
45 COLOR 7
50 CLS
55 REM %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
60 REM % Beginning of program to draw a gray %
65 REM % scale image on the screen %
70 REM %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
75 DEFINT I, J, N, X, Y, P
80 REM %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
85 REM % I and J are FOR loop variables %
90 REM % N is the size of the image
95 REM % X and Y are SCREEN coordinates %
100 REM % P is to designate the PATTERN %
105 REM % arrays as integer arrays %
110 REM %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
115 DIM PATTERN0(3), PATTERN1(3), PATTERN2(3), PATTERN3(3)
120 DIM PATTERN4(3), PATTERN5(3), PATTERN6(3), PATTERN7(3)
125 DIM PATTERN8(3), PATTERN9(3), PATTERNA(3), PATTERNB(3)
130 DIM PATTERNC(3), PATTERND(3), PATTERNE(3), PATTERNF(3)
135 PATTERN0(0)=5 : PATTERN0(1) = 3
140 PATTERN1(0)=5 : PATTERN1(1) = 3
145 PATTERN2(0)=5 : PATTERN2(1) = 3
150 PATTERN3(0)=5 : PATTERN3(1) = 3
155 PATTERN4(0)=5 : PATTERN4(1) = 3
160 PATTERN5(0)=5 : PATTERN5(1) = 3
165 PATTERN6(0)=5 : PATTERN6(1) = 3
170 PATTERN7(0)=5 : PATTERN7(1) = 3
175 PATTERN8(0)=5 : PATTERN8(1) = 3
180 PATTERN9(0)=5 : PATTERN9(1) = 3
185 PATTERNA(0)=5 : PATTERNA(1) = 3
190 PATTERNB(0)=5 : PATTERNB(1) = 3
195 PATTERNC(0)=5 : PATTERNC(1) = 3
200 PATTERND(0)=5 : PATTERND(1) = 3
205 PATTERNE(0)=5 : PATTERNE(1) = 3
210 PATTERNF(0)=5 : PATTERNF(1) = 3
215 REM %%%%%%%%%%%%%%%%%%%%%%%%%%%
220 REM % Define the gray scale %
225 REM % patterns for each array %
230 REM %%%%%%%%%%%%%%%%%%%%%%%%%%%
235 PATTERN0(2)= 0 : PATTERN0(3) = 0
240 PATTERN1(2)= 8192 : PATTERN1(3) = 0
245 PATTERN2(2)= 8192 : PATTERN2(3) = 128
250 PATTERN3(2)= 2176 : PATTERN3(3) = 32
255 PATTERN4(2)= 2176 : PATTERN4(3) = 80
260 PATTERN5(2)= 8336 : PATTERN5(3) = 72
265 PATTERN6(2)= 10384 : PATTERN6(3) = 80
270 PATTERN7(2)= 26768 : PATTERN7(3) = 80
275 PATTERN8(2)=NOT PATTERN7(2) : PATTERN8(3)=NOT PATTERN7(3)
280 PATTERN9(2)=NOT PATTERN6(2) : PATTERN9(3)=NOT PATTERN6(3)
285 PATTERNA(2)=NOT PATTERN5(2) : PATTERNA(3)=NOT PATTERN5(3)
290 PATTERNB(2)=NOT PATTERN4(2) : PATTERNB(3)=NOT PATTERN4(3)
295 PATTERNC(2)=NOT PATTERN3(2) : PATTERNC(3)=NOT PATTERN3(3)
300 PATTERND(2)=NOT PATTERN2(2) : PATTERND(3)=NOT PATTERN2(3)
305 PATTERNE(2)=NOT PATTERN1(2) : PATTERNE(3)=NOT PATTERN1(3)
310 PATTERNF(2)=NOT PATTERN0(2) : PATTERNF(3)=NOT PATTERN0(3)
315 REM %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
320 REM % The name of the data file is assigned %
325 REM % to the string variable FILENAME$. The %
330 REM % data file is assumed to consist of M %
335 REM % rows of N hex digits M ≤ N ≤ 128. The %
340 REM % program reads the first row of data to %
345 REM % determine N. Once the gray scale image %
350 REM % of the data file has been generated it %
355 REM % is saved under the same name but with %
360 REM % an extension of .SAV. If the corre- %
365 REM % sponding .SAV file is found, then it %
370 REM % is immediately displayed. %
375 REM %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
380 INPUT; "Name of data file "; FILENAME$ : CLS
385 NAMELENGTH = LEN(FILENAME$)
390 FOR I = 1 TO 4
395 IF ASC(RIGHT$(FILENAME$,I)) = &H2E THEN NAMELENGTH = LEN(FILENAME$) - I
400 NEXT I
405 FILESAVE$ = LEFT$(FILENAME$,NAMELENGTH)+".SAV"
410 ON ERROR GOTO 655
415 DEF SEG = &HB800
420 BLOAD FILESAVE$,0
425 GOTO 425
430 OPEN FILENAME$ FOR INPUT AS #1
435 BEGIN% = 1
440 WHILE NOT EOF(1)
445 LINE INPUT #1, ROW$
450 WHILE BEGIN%
455 BEGIN% = 0
460 N = LEN(ROW$)
465 IF N > 128 THEN SYSTEM ELSE NX = INT(640/(5*N)) : NY = INT(400/(3*N))
470 DX% = 5*NX : DY% = 3*NY
475 Y = -DY%
480 WEND
485 ROWLENGTH% = LEN(ROW$) : X = -DX% : Y = Y + DY%
490 FOR JX = 1 TO ROWLENGTH%
495 HEXDIGIT$=MID$(ROW$,JX,1)
500 X = X + DX%
505 FOR I = 0 TO DX% - 1 STEP 5
510 FOR J = 0 TO DY% - 1 STEP 3
515 ON ASC(HEXDIGIT$)-&H30 GOTO 525,530,535,540,545,550,555,560,565,570,570,570,570,570,570,570,570,575,580,585,590,595
520 PUT(X + I, Y + J),PATTERN0,PSET : GOTO 600
525 PUT(X + I, Y + J),PATTERN1,PSET : GOTO 600
530 PUT(X + I, Y + J),PATTERN2,PSET : GOTO 600
535 PUT(X + I, Y + J),PATTERN3,PSET : GOTO 600
540 PUT(X + I, Y + J),PATTERN4,PSET : GOTO 600
545 PUT(X + I, Y + J),PATTERN5,PSET : GOTO 600
550 PUT(X + I, Y + J),PATTERN6,PSET : GOTO 600
555 PUT(X + I, Y + J),PATTERN7,PSET : GOTO 600
560 PUT(X + I, Y + J),PATTERN8,PSET : GOTO 600
565 PUT(X + I, Y + J),PATTERN9,PSET : GOTO 600
570 PUT(X + I, Y + J),PATTERNA,PSET : GOTO 600
575 PUT(X + I, Y + J),PATTERNB,PSET : GOTO 600
580 PUT(X + I, Y + J),PATTERNC,PSET : GOTO 600
585 PUT(X + I, Y + J),PATTERND,PSET : GOTO 600
590 PUT(X + I, Y + J),PATTERNE,PSET : GOTO 600
595 PUT(X + I, Y + J),PATTERNF,PSET : GOTO 600
600 NEXT J
605 NEXT I
610 NEXT JX
615 WEND
620 BEEP
625 GOTO 625
630 REM %%%%%%%%%%%%%%%%%%%%%
635 REM % File I/O Error %
640 REM % trapping routines %
645 REM %%%%%%%%%%%%%%%%%%%%%
650 REM
655 IF ERR = 53 AND ERL = 420 THEN NOTEXISTS% = 1 : RESUME 430
660 IF ERR = 53 AND ERL = 430 THEN 665 ELSE 670
665 PRINT FILENAME$," file not found" : END
670 PRINT "Some error occurred that I was not expecting";ERR,ERL : END
675 CLOSE #1
680 IF NOTEXISTS% = 0 THEN 715
685 REM
690 REM %%%%%%%%%%%%%%%%%%%%%
695 REM % Save the screen %
700 REM %%%%%%%%%%%%%%%%%%%%%
705 DEF SEG = &HB800
710 BSAVE FILESAVE$,0,32767
715 SCREEN 0
720 SYSTEM